home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Utilities Professional 1-1500
/
Utilities Professional 1-1500 (1994)(WPD)[!].iso
/
10011250
/
var1219.dms
/
var1219.adf
/
ARexxGuide
/
ARx_Help.ttx
< prev
next >
Wrap
Text File
|
1992-09-02
|
13KB
|
460 lines
/** $VER: ARX_GetRef.ttx 0.2 (21 Jul 1993)
** by Robin Evans (based on getxfef.ttx by David N. Junod)
**
** Display the ARexxGuide page for the word currently under the
** cursor.
**
** Add the following line to your TTX_Startup.dfn file, in the KEYBOARD:
** section.
**
** HELP ExecARexxMacro REXX:GetXRef.ttx SYNC
** SHIFT-HELP ExecARexxMacro REXX:GetXRef.ttx ASYNC
**
** Add the following lines to your S:user-startup file.
**
** RX "AddLib('amigaguide.library',0,-30)"
**/
TRUE=1; FALSE=0
options results
parse arg Mode LkUp
if ~show('L','amigaguide.library') then
call addlib('amigaguide.library',0,-30)
if ~show('L','rexxarplib.library') then
call addlib('rexxarplib.library',0,-30)
/* Did they pass a word? */
if LkUp = "" then do
/* Get all the line info we'll need and lock out input until **
** it's all collected. **
** Check for special characters first */
'SetInputLock on'
'GetLine 1'
HLine = Tab2Space(result)
'GetCursorPos'
CurPos = word(result, 2)
'GetChar'
MChar = pos(result, '+-/*|&^><=,;:~)("'||'2720090a'x)
'SetInputLock off'
select
when MChar = 0 then do
/* Look for whole word if it isn't a special character */
'GetWord'
LkUp = result
end
when MChar <= 2 then
LkUp = 'ARITHMETIC'
when MChar <= 4 then do
/* This picks up the three characters surrounding a '*' or '/' */
ComChar = substr(HLine, CurPos - 1, 3)
if pos('/*', ComChar) + pos('*/', ComChar) > 0 then
LkUp = 'COMMENT'
else
LkUp = 'ARITHMETIC'
end
when MChar <= 7 then
LkUp = 'LOGICAL'
when MChar <= 9 then
LkUp = 'COMPARISON'
when MChar = 10 then
if symbol(strip(left(HLine, CurPos-1))) == 'BAD' then
LkUp = 'COMPARISON'
else
LkUp = 'ASSIGNMENT'
when MChar = 11 then
LkUp = 'COMMA'
when MChar = 12 then
LkUp = 'SEMICOLON'
when MChar = 13 then
LkUp = 'LABEL'
when MChar = 14 then do /* Tilde */
/* is the next character a comparison operator? */
if pos(substr(HLine, CurPos , 2), '~=~>~<') > 0 then
LkUp = 'COMPARISON'
else
LkUp = 'LOGICAL'
end
when MChar <=16 then
LkUp = 'PAREN'
when MChar <= 18 then /* Quotation marks */
LkUp = 'STRING'
when MChar > 18 then
if HLine = '' | verify(HLine, ' ;') = 0 then do
call ShowInfo(,, CurPos)
exit
end
else if CurPos >= wordindex(HLine, 1) then do
'GetWord'
LkUp = result
end
else do
call ShowInfo(HLine,, CurPos)
exit
end
otherwise
end
end
/* Show that we're doing something */
'SetStatusBar TEMPORARY Checking for 'LkUp'...'
/* See if the ARexxGuide cross-reference table is loaded */
if GetXRef("pragma()") = 10 then do
/* Show that we're doing something */
'SetStatusBar TEMPORARY Loading cross-reference file...'
/* The ARexxGuide table wasn't loaded, so load it. */
call LoadXRef('ARx_Guide.xref')
end
/* Show functions as first preference */
XMatch = TRUE
if GetXRef(LkUp'()') ~= 10 then
/* Make sure it's used as a function */
if pos(LkUp'(', HLine) > 0 | pos(LkUp"'(", HLine) > 0 | pos(LkUp'"(', HLine) > 0 then
LkUp = LkUp'()'
/* if it's not a match of instructions, then check for option words */
if GetXRef(LkUp) = 10 | upper(LkUp) == 'ARG' | upper(LkUp) == 'PULL' then do
Kwd = upper(word(HLine, 1))
if word(GetXRef(Kwd),3) = 2 then select
when Kwd == 'ARG' then
XMatch = TRUE
when Kwd == 'PULL' then
XMatch = TRUE
when Kwd = 'DO' then do
SpecWord = find('UNTIL WHILE TO FOR BY FOREVER ', upper(LkUp))
if SpecWord > 0 then
LkUp = word('DOOPT4 DOOPT4 DOOPT2 DOOPT3 DOOPT2 DOOPT5', SpecWord)
else XMatch = FALSE
end
when Kwd = 'PARSE' then do
SpecWord = find('ARG PULL EXTERNAL NUMERIC SOURCE VERSION VALUE VAR WITH', upper(LkUp))
if SpecWord > 0 then do
LkUp = 'PARSESRC'SpecWord
if LkUp == 'PARSESRC9' then
LkUp = 'PARSESRC7'
end
else XMatch = FALSE
end
when Kwd = 'OPTIONS' then
if find('RESULTS PROMPT FAILAT CASHE ON OFF', upper(LkUp)) > 0 then
LkUp = Kwd
else XMatch = FALSE
when Kwd = 'TRACE' then
if verify(upper(LkUp), 'IRACLENOBS') = 0 then
LkUp = 'TRACEOPT'
else XMatch = FALSE
when Kwd = 'SIGNAL' then
if find('BREAK_C BREAK_D BREAK_E BREAK_F ERROR FAILURE HALT IOERROR NOVALUE SYNTAX ON OFF', upper(LkUp)) > 0 then
LkUp = 'SIGNAL'
else XMatch = FALSE
otherwise
XMatch = FALSE
end
else XMatch = FALSE
end
AGCmd = getenv('ARexxGuide/AGCmd')
if abbrev(AGCmd, 'Multi') then
PrtOpt = ''
else
PrtOpt = 'portname ARX_GUIDE'
if ~XMatch then do
foo= ShowInfo(HLine, LkUp, CurPos)
/*
'RequestBool "'center(upper(LkUp) 'not found.',37)'" "'center('Show ARexxGuide index?',37)'"'
if result = 'YES' then do
XMatch = TRUE; LkUp = 'ARx_Index/MAIN'
Cmd = 'run' AGCmd 'ARx_Index' PrtOpt 'requester'
end
*/
end
else do
NTNum = word(getxref(LkUp), 3)
NodeType.0 = 'Explanation'; NodeType.1 = 'Function'; NodeType.2 = 'Instruction'
/* Show that we're doing something */
'SetStatusBar ARexxGuide: 'upper(LkUp) '['NodeType.NTNum']'
Cmd = ''
/* See if our AG window is open */
if ~show('P','ARX_GUIDE') then do
if Cmd = '' then
Cmd = 'run' AGCmd 'document' LkUp PrtOpt 'requester'
address command cmd
end
else do
/* What command do we use to show the node */
Link = "Link"
if mode = "ASYNC" then
Link = "ALink"
else
call setclip('ARx_NdxWin') /* clear the asynch clip */
/* show the node */
address ARX_GUIDE 'windowtofront'
address ARX_GUIDE 'Link' LkUp
end
end
exit
ShowInfo: procedure expose AGCmd
parse arg HLine, LkUp, CurPos
/* Show that we're doing something */
'SetStatusBar TEMPORARY "'LkUp'" not found. Checking clause...'
/* this will break if a semicolon is used within a string */
SemPos = pos(';', HLine)
do while SemPos > 0 & SemPos < CurPos
parse var HLine ';' HLine
CurPos = CurPos - SemPos
SemPos = pos(';', HLine)
end
/* get rid of any trailing clauses */
parse var HLine HLine ';'
if ~abbrev(AGCmd, 'Multi') then
ExecStr = 'ExecARexxString address ARXTTX quit; if ~show(P, ARX_GUIDE) then do; address command; run "'getenv("arexxguide/AGCmd") 'ARexxGuide.guide portname ARX_GUIDE";waitforport ARX_GUIDE; end; address ARX_GUIDE; windowtofront;'
else
ExecStr = 'ExecARexxString address ARXTTX quit; address command; run "'AGCmd'"ARexxGuide.guide"'
/* figure out what type of clause the current line is */
select
when word(HLine, 2) = '=' then do
CType = 2
end
when getxref(word(HLine,1)) ~= 10 then do
Xref = getxref(word(HLine,1))
if word(Xref,3) = 2 then
CType = 1
end
when pos('/*', HLine) < CurPos & pos('/*', HLine) ~= 0 then
if pos('*/', HLine) > CurPos | pos('*/', HLine) = 0 then
CType = 4
when right(word(HLine,1), 1) = ':' then
CType = 3
when HLine = '' then
CType = 5
otherwise
CType = 0
EqPos = pos('=', HLine)
if EqPos > 0 then do
if symbol(strip(left(HLine, EqPos-1))) ~= 'BAD' then do
HLine=insert(' ', HLine, EqPos - 1)
HLine = insert(' ', HLine, EqPos + 2)
CType = 2
end
end
end
if CType = 2 then
if ~IsVar(word(HLine, 1)) then
CType = 0
/* Prepare the window gadgets */
CName.0 = 'Command'
CName.1 = 'Instruction'
CName.2 = 'Assignment'
CName.3 = 'Label'
CName.4 = 'Comment'
CName.5 = 'Null'
Gad. = ''
Gad.1.6Txt = 'Current clause is'
Gad.1.6Btn = CName.CType
Gad.1.6Cmd = ExecStr 'link' CName.CType
Gadgets = 1
select
when CType = 1 then do
Kwd = upper(word(HLine,1))
Gad.2.6Txt = 'Current keyword is'
Gad.2.6Btn = Kwd
Gad.2.6Cmd = ExecStr 'link' Kwd
Gadgets = 2
end
when CType = 3 then do
Gad.2.6Txt = 'Name of subroutine:' word(HLine,1)'.'
Gadgets = 2
end
otherwise
end
/* Figure out what the current word is doing */
if CType <= 2 & LkUp > '' then do
DType = datatype(LkUp)
/* Split the string so we can compare both sides */
parse var HLine LStr =CurPos RStr
/* Get only the portion of the string which contains LkUp */
WdRange = substr(HLine, max(1, CurPos - length(LkUp)), length(LkUp) *2)
/* Use Bit functions to keep multiple matches */
WType = null()
if verify(HLine, '"''', M) > 0 then
if CountChar(LStr, "'")//2 then do
WType = bitset(WType,2)
if pos(LkUp"'(", WdRange) & IsVar(LkUp) then
WType = bitset(WType, 0)
end
else if CountChar(LStr, '"')//2 then do
WType = bitset(WType,3)
if pos(LkUp'"(', WdRange) & IsVar(LkUp) then
WType = bitset(WType, 0)
end
/* Is current word enclosed in parens? */
if verify(HLine, "()", M) > 0 then do
if (CountChar(RStr, ')')-CountChar(RStr, '(')) =,
(CountChar(LStr, '(')-CountChar(LStr, ')')) then
WType = bitset(WType, 1)
if pos(LkUp'(', WdRange) > 0 & IsVar(LkUp) then
WType = bitset(WType, 0)
end
/* is it a number, variable, or constant? */
if datatype(LkUp, N) then
if datatype(LkUp, B) & bittst(WType, 2) then
if pos(LkUp"'B", upper(WdRange)) > 0 | pos(LkUp'"B', upper(WdRange)) > 0 then
WType = bitset(WType, 6)
else
WType = bitset(WType, 4)
else if datatype(LkUp, X) & bittst(WType, 2) then
if pos(LkUp"'X", upper(WdRange)) > 0 | pos(LkUp'"X', upper(WdRange)) > 0 then
WType = bitset(WType, 5)
else
WType = bitset(WType, 4)
else
WType = bitset(WType, 4)
else
if bittst(WType, 2) then do
if datatype(LkUp, X) then
WType = bitset(WType, 5)
end
else if IsVar(LkUp) then
if ~bittst(WType, 0) then
WType = bitset(WType, 3)
else NOP
else
WType = bitset(WType, 7)
/** Prepare gadgets to explain current word **/
if WType ~= null() then do
interpret 'Gad.'Gadgets+1'.6Txt = ''"''Lkup''" is'''
if bittst(WType, 0) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Function name'
Gad.Gadgets.6Cmd = ExecStr 'link FUNCTION'
end
if bittst(WType, 1) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Function argument'
Gad.Gadgets.6Cmd = ExecStr 'link FUNCTION'
end
if bittst(WType, 2) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'String'
Gad.Gadgets.6Cmd = ExecStr 'link STRINGEXPR'
end
if bittst(WType, 3) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Variable'
Gad.Gadgets.6Cmd = ExecStr 'link VARIABLE'
end
if bittst(WType, 4) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Number'
Gad.Gadgets.6Cmd = ExecStr 'link NUMBER'
end
if bittst(WType, 5) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Hex string'
Gad.Gadgets.6Cmd = ExecStr 'link HEXSTRING'
end
if bittst(WType, 6) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Binary string'
Gad.Gadgets.6Cmd = ExecStr 'link HEXSTRING'
end
if bittst(WType, 7) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Constant symbol'
Gad.Gadgets.6Cmd = ExecStr 'link CONSTANT'
end
end
end
/* Open the rexxarplib requester window */
CPort = 'ARXTTX'
if ~InfoWin(CPort, Gadgets+2, 'Lookup:' LkUp) then return 10
x = 10; y = 32
do i = 1 to Gadgets
move(CPort, x, y)
if Gad.i.6Btn = '' then
Txt = center(Gad.i.6Txt,47)
else
Txt = right(Gad.i.6Txt, 21)
call Text(CPort, Txt)
if Gad.i.6Btn > '' then
call AddGadget(CPort, 192, y - 9, i, ' 'left(Gad.i.6Btn, 26),Gad.i.6Cmd)
y = y + 15
end
call AddGadget(CPort, 10, y-4, 14, ' View ARexxGuide index ',ExecStr '"link Arx_Index/MAIN"')
call AddGadget(CPort, 344, y-4, 15, ' Cancel ', 'ExecARexxString address ARXTTX quit')
return 0
InfoWin: procedure
parse arg CPort, Rows, WinTitle
PoC = address()
/** shut down previous requester if it's still around **/
if show(P, CPort) then do; address value CPort; quit; address; end
'GetWindowInfo'
x= word(result,3); y= word(result,3)
'GetScreenInfo'
PubScreen = word(result, words(result))
/* change notifyport (PoC) to a port read by this script */
address ARexx "'call CreateHost("CPort"," PoC", "PubScreen")'"
/** Open the window **/
idcmp = 'CLOSEWINDOW+GADGETUP'
flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+ACTIVATE'
address command 'waitforport' CPort
Height = 16+15*Rows
if rc = 0 then do
call OpenWindow(CPort, x, y, 422, Height, idcmp,flags, WinTitle)
call SetAPen(CPort, 2)
call SetNotify(CPort, CLOSEWINDOW, CPort)
return 1
else
return 0
Tab2Space: procedure
parse arg line
'GetPrefs tabwidth'
tabsize = result
tpos=pos('09'x,Line);
do while tpos>0;
Line=insert('',Line, tpos, tabsize-tpos//tabsize);
tpos=pos('09'x, Line,tpos+1);
end;
return translate(Line,' ','09'x)
CountChar:
parse arg IStr, Char
return length(IStr) - length(compress(IStr, Char))
IsVar:
call trace b
return symbol(arg(1)) ~== 'BAD' & datatype(left(arg(1),1), m)